perm filename LEARN.SAI[11,ALS] blob
sn#061558 filedate 1973-09-10 generic text, type T, neo UTF8
00010 BEGIN "SAY"
00020 DEFINE ⊂="COMMENT"; ⊂ 9/2/73 Runs SIG from FIX output;
00030 DEFINE NU="'250000000000";
00040 DEFINE ⊃="⊂ "; ⊂ Replace by "" to get running commentary;
00050
00060 REQUIRE "SIG[4,ALS]" LOAD_MODULE;
00070 REQUIRE "BLOCKS.HDR[4,ALS]" SOURCE_FILE;
00080 EXTERNAL FORTRAN PROCEDURE SIG(REFERENCE INTEGER P);
00090 INTEGER ARRAY LFILE[0:'177];
00100 INTERNAL INTEGER ARRAY INDATA[0:255];
00110 INTERNAL INTEGER H,I,J,K,L,M,N,P,NF,Q;
00120 INTERNAL INTEGER FLAG,CFLAG,RFLAG,UPCNT,TABTOT;
00130 INTERNAL INTEGER SEGC,INTOT,SEGTOT,HINT,BPT,PHW,SMOCNT,SMCNT2,ZCNT;
00140 INTEGER NEW,OLD,SUM,S1,S2,S3,S4,RL,PREHINT;
00150 INTEGER ARRAY N1[0:3];
00160 INTEGER HINCNT,HCOUNT,HINDEX,EOF,EOFA,EOFB,BRK;
00170 INTEGER CHAN1,CHAN2,CHAN3,CHAN4,CHAN5,CHAN6;
00180 STRING READ1,FILEL,FILEI,TFILE,TFILEI,FILLST;
00190 DEFINE ARRSIZ="4096";
00200 INTERNAL INTEGER ARRAY LRN[0:ARRSIZ];
00210 INTERNAL INTEGER ARRAY RES,USE[0:TABSIZ];
00220 BOOLEAN ER;
00230
00240 INTEGER PROCEDURE HEADER;
00250 BEGIN "HEADER"
00260 INTEGER I,J,K,H1;
00270 IF HCOUNT>1 THEN BEGIN
00280 HCOUNT←HCOUNT-1;
00290 IF PREHINT≠NU THEN HINCNT←HINCNT+1; END
00300 ELSE WHILE TRUE DO BEGIN "XX"
00310 I←LFILE[HINDEX]; K←LDB(POINT(14,I,27)); J←SEGC-K;
00320 IF I=0 THEN BEGIN PREHINT←NU; HCOUNT←999; DONE END;
00330 IF J<0 THEN BEGIN HCOUNT← -J;
00340 PREHINT←NU; DONE END;
00350 PREHINT←I LAND '777760000000;
00360 HINDEX←HINDEX+1; HINCNT←HINCNT+1;
00370 HCOUNT←LDB(POINT(8,I,35));
00380 IF J>0 THEN BEGIN HCOUNT←HCOUNT-J;
00390 OUTSTR(CRLF&" "&CVS(J)&" overlap. hint -"&cvstr(prehint));
00400 OUTSTR("- now starts at "&CVS(SEGC)&crlf); END;
00410 IF HCOUNT>0 THEN DONE END "XX";
00420 RETURN(PREHINT);
00430 END "HEADER";
00440
00450 PROCEDURE SMOOTH;
00460 BEGIN "SMOOTH"
00470
00480 INTEGER ARRAY X,D[0:3];
00490 INTEGER P,Q;
00500
00510 X[0]←K LSH -(N1[1]+N1[2]+N1[3]);
00520 X[1]←(K LSH -(N1[2]+N1[3])) LAND ('377 LSH (N1[1]-8));
00530 X[2]←(K LSH -N1[3]) LAND ('377 LSH (N1[2]-8));
00540 X[3]←K LAND ('377 LSH (N1[3]-8));
00550
00560 D[0]←1 LSH (N1[1]+N1[2]+N1[3]);
00570 D[1]←1 LSH (N1[2]+N1[3]);
00580 D[2]←1 LSH N1[3]; ⊂ Not used if N1[2]=0;
00590 D[3]←1; ⊂ Not used and having no meaning if N1[3]=0;
00600
00610 FOR P←0 STEP 1 UNTIL 3 DO IF N1[P]≠0 THEN BEGIN
00620
00630 IF X[P]>0 THEN BEGIN
00640 S1←S1+(LDB(POINT(9,RES[K-D[P]],8)) LSH 5)+LDB(POINT(9,LRN[L-D[P]],8));
00650 S2←S2+(LDB(POINT(9,RES[K-D[P]],17)) LSH 5)+LDB(POINT(9,LRN[L-D[P]],17));
00660 S3←S3+(LDB(POINT(9,RES[K-D[P]],26)) LSH 5)+LDB(POINT(9,LRN[L-D[P]],26));
00670 S4←S4+(LDB(POINT(9,RES[K-D[P]],35)) LSH 5)+LDB(POINT(9,LRN[L-D[P]],35));
00680 END;
00690
00700 IF X[P]<(1 LSH N1[P])-1 THEN BEGIN
00710 S1←S1+(LDB(POINT(9,RES[K+D[P]],8)) LSH 5)+LDB(POINT(9,LRN[L+D[P]],8));
00720 S2←S2+(LDB(POINT(9,RES[K+D[P]],17)) LSH 5)+LDB(POINT(9,LRN[L+D[P]],17));
00730 S3←S3+(LDB(POINT(9,RES[K+D[P]],26)) LSH 5)+LDB(POINT(9,LRN[L+D[P]],26));
00740 S4←S4+(LDB(POINT(9,RES[K+D[P]],35)) LSH 5)+LDB(POINT(9,LRN[L+D[P]],35));
00750 END; END;
00760
00770
00780 SUM←S1+S2+S3+S4;
00790 IF SUM≠0 THEN SMOCNT←SMOCNT+1 ELSE BEGIN
00800
00810 FOR P←0 STEP 1 UNTIL 3 DO IF N1[P]≠0 THEN BEGIN
00820
00830
00840 IF X[P]>0 THEN FOR Q←P+1 STEP 1 UNTIL 3 DO IF N1[Q]≠0 THEN BEGIN
00850
00860 IF X[Q]>0 THEN BEGIN
00870 S1←S1+(LDB(POINT(9,RES[K-D[P]-D[Q]],8)) LSH 5)+LDB(POINT(9,LRN[L-D[P]-D[Q]],8));
00880 S2←S2+(LDB(POINT(9,RES[K-D[P]-D[Q]],17)) LSH 5)+LDB(POINT(9,LRN[L-D[P]-D[Q]],17));
00890 S3←S3+(LDB(POINT(9,RES[K-D[P]-D[Q]],26)) LSH 5)+LDB(POINT(9,LRN[L-D[P]-D[Q]],26));
00900 S4←S4+(LDB(POINT(9,RES[K-D[P]-D[Q]],35)) LSH 5)+LDB(POINT(9,LRN[L-D[P]-D[Q]],35));
00910 END;
00920
00930 IF X[Q]<(1 LSH N1[Q])-1 THEN BEGIN
00940 S1←S1+(LDB(POINT(9,RES[K-D[P]+D[Q]],8)) LSH 5)+LDB(POINT(9,LRN[L-D[P]+D[Q]],8));
00950 S2←S2+(LDB(POINT(9,RES[K-D[P]+D[Q]],17)) LSH 5)+LDB(POINT(9,LRN[L-D[P]+D[Q]],17));
00960 S3←S3+(LDB(POINT(9,RES[K-D[P]+D[Q]],26)) LSH 5)+LDB(POINT(9,LRN[L-D[P]+D[Q]],26));
00970 S4←S4+(LDB(POINT(9,RES[K-D[P]+D[Q]],35)) LSH 5)+LDB(POINT(9,LRN[L-D[P]+D[Q]],35));
00980 END; END;
00990
01000 IF X[P]>1 THEN BEGIN
01010 S1←S1+(LDB(POINT(9,RES[K-D[P]*2],8)) LSH 5)+LDB(POINT(9,LRN[L-D[P]*2],8));
01020 S2←S2+(LDB(POINT(9,RES[K-D[P]*2],17)) LSH 5)+LDB(POINT(9,LRN[L-D[P]*2],17));
01030 S3←S3+(LDB(POINT(9,RES[K-D[P]*2],26)) LSH 5)+LDB(POINT(9,LRN[L-D[P]*2],26));
01040 S4←S4+(LDB(POINT(9,RES[K-D[P]*2],35)) LSH 5)+LDB(POINT(9,LRN[L-D[P]*2],35));
01050 END;
01060
01070
01080 IF X[P]<(1 LSH N1[P])-1 THEN
01090 FOR Q←P+1 STEP 1 UNTIL 3 DO IF N1[Q]≠0 THEN BEGIN
01100
01110 IF X[Q]>0 THEN BEGIN
01120 S1←S1+(LDB(POINT(9,RES[K+D[P]-D[Q]],8)) LSH 5)+LDB(POINT(9,LRN[L+D[P]-D[Q]],8));
01130 S2←S2+(LDB(POINT(9,RES[K+D[P]-D[Q]],17)) LSH 5)+LDB(POINT(9,LRN[L+D[P]-D[Q]],17));
01140 S3←S3+(LDB(POINT(9,RES[K+D[P]-D[Q]],26)) LSH 5)+LDB(POINT(9,LRN[L+D[P]-D[Q]],26));
01150 S4←S4+(LDB(POINT(9,RES[K+D[P]-D[Q]],35)) LSH 5)+LDB(POINT(9,LRN[L+D[P]-D[Q]],35));
01160 END;
01170
01180 IF X[Q]<(1 LSH N1[Q])-1 THEN BEGIN
01190 S1←S1+(LDB(POINT(9,RES[K+D[P]+D[Q]],8)) LSH 5)+LDB(POINT(9,LRN[L+D[P]+D[Q]],8));
01200 S2←S2+(LDB(POINT(9,RES[K+D[P]+D[Q]],17)) LSH 5)+LDB(POINT(9,LRN[L+D[P]+D[Q]],17));
01210 S3←S3+(LDB(POINT(9,RES[K+D[P]+D[Q]],26)) LSH 5)+LDB(POINT(9,LRN[L+D[P]+D[Q]],26));
01220 S4←S4+(LDB(POINT(9,RES[K+D[P]+D[Q]],35)) LSH 5)+LDB(POINT(9,LRN[L+D[P]+D[Q]],35));
01230 END; END;
01240
01250 IF X[P]<(1 LSH N1[P])-2 THEN BEGIN
01260 S1←S1+(LDB(POINT(9,RES[K+D[P]*2],8)) LSH 5)+LDB(POINT(9,LRN[L+D[P]*2],8));
01270 S2←S2+(LDB(POINT(9,RES[K+D[P]*2],17)) LSH 5)+LDB(POINT(9,LRN[L+D[P]*2],17));
01280 S3←S3+(LDB(POINT(9,RES[K+D[P]*2],26)) LSH 5)+LDB(POINT(9,LRN[L+D[P]*2],26));
01290 S4←S4+(LDB(POINT(9,RES[K+D[P]*2],35)) LSH 5)+LDB(POINT(9,LRN[L+D[P]*2],35));
01300 END;
01310
01320 END;
01330
01340 SUM←S1+S2+S3+S4;
01350 IF SUM≠0 THEN SMCNT2←SMCNT2+1;
01360 END;
01370
01380 IF SUM=0 THEN BEGIN ZCNT←ZCNT+1; S1←S2←S3←S4←'200; SUM←'1000; END;
01390
01400 END "SMOOTH";
01410
01420 PROCEDURE UPDATE;
01430 BEGIN "UPDATE"
01440
01450 OUTSTR(CRLF);
01460 CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,10,0,0,0,EOF);
01470 LOOKUP(CHAN2,"RES.DAT",RFLAG);
01480 CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,0,10,0,0,0);
01490 ENTER(CHAN3,"RES.NEW",0);
01500 CLOSE(CHAN6); OPEN(CHAN6,"DSK",'10,0,10,0,0,0);
01510 ENTER(CHAN6,"USE.DAT",0);
01520 SETFORMAT(3,0);
01530
01540 FOR I←0 STEP 1 UNTIL TABNUM DO BEGIN
01550 IF NAMES[I]=0 THEN DONE;
01560 J←I*TABSIZ;
01570 N1[0]←LDB(POINT(3,IN1[I],11));
01580 N1[1]←LDB(POINT(3,IN2[I],11));
01590 N1[2]←LDB(POINT(3,IN3[I],11));
01600 N1[3]←LDB(POINT(3,IN4[I],11));
01610
01620 FOR K←0 STEP 1 UNTIL TABSIZ-1 DO RES[K]←0;
01630 ARRYIN(CHAN2,RES[0],TABSIZ);
01640
01650 FOR K←0 STEP 1 UNTIL TABSIZ-1 DO BEGIN
01660 L←J+K;
01670
01680 NEW←LDB(POINT(9,LRN[L],8));
01690 OLD←LDB(POINT(9,RES[K],8));
01700 S1←(OLD LSH 5)+NEW;
01710
01720 NEW←LDB(POINT(9,LRN[L],17));
01730 OLD←LDB(POINT(9,RES[K],17));
01740 S2←(OLD LSH 5)+NEW;
01750
01760 NEW←LDB(POINT(9,LRN[L],26));
01770 OLD←LDB(POINT(9,RES[K],26));
01780 S3←(OLD LSH 5)+NEW;
01790
01800 NEW←LDB(POINT(9,LRN[L],35));
01810 OLD←LDB(POINT(9,RES[K],35));
01820 S4←(OLD LSH 5)+NEW;
01830
01840 RES[K]←((S1 LSH -5) LSH 27) + ((S2 LSH -5) LSH 18)
01850 + ((S3 LSH -5) LSH 9) + (S4 LSH -5);
01860 LRN[L]←LRN[L] LAND '037037037037;
01870
01880 SUM←S1+S2+S3+S4;
01890 IF SUM=0 THEN SMOOTH;
01900
01910 S1←(S1 LSH 9)%SUM; S2←(S2 LSH 9)%SUM;
01920 S3←(S3 LSH 9)%SUM; S4←(S4 LSH 9)%SUM;
01930 IF S1=512 THEN S1←511 ELSE IF S2=512 THEN S2←511 ELSE
01940 IF S3=512 THEN S3←511 ELSE IF S4=512 THEN S4←511;
01950 USE[K]←(S1 LSH 27)+(S2 LSH 18)+(S3 LSH 9) +S4;
01960 END;
01970
01980 ARRYOUT(CHAN3,RES[0],TABSIZ); ARRYOUT(CHAN6,USE[0],TABSIZ);
01990 OUTSTR("Table "&CVSTR(NAMES[I])); OUTSTR(TB
02000 &CVS(SMOCNT)&" near-smoothed "
02010 &CVS(SMCNT2)&" far-smoothed "&CVS(ZCNT)&" averaged."&CRLF);
02020 SMOCNT←smcnt2←ZCNT←0;
02030 END;
02040 ⊂ CLOSE(CHAN2); RENAME(CHAN2,"",0,0); RELEASE(CHAN2);
02050 CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,10,0,0,0,EOF);
02060 LOOKUP(CHAN3,"RES.NEW",0);RENAME(CHAN3,"RES.DAT",0,0); RELEASE(CHAN3);
02070 CLOSE(CHAN6);
02080 CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,0,10,0,0,EOF);
02090 ENTER(CHAN1,"LRN.DAT",0);
02100 ARRYOUT(CHAN1,LRN[0],TABTOT); CLOSE(CHAN1);
02110 OUTSTR("Update completed."&CRLF);
02120 END "UPDATE";
02130
00010 STDBRK(1);
00020 SETBREAK(14,"∃",NULL,"INS");
00030
00040 FILEL←"LIST28";
00050 FILEI←"TOO1.DAT[1,THO]";
00060 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4; CHAN5←5; CHAN6←6;
00070 HEADIN;
00080 FOR I←0 STEP 1 UNTIL 63 DO BEGIN if phlist[i]=0 then done;
00090 ⊃ OUTSTR(CVOS(PHLIST[I])&TB&CVSTR(PHLIST[I])); ⊃ OUTSTR(CRLF); END;
00100 FOR I←0 STEP 1 UNTIL 15 DO IF NAMES[I]=0 THEN DONE; TABTOT←I*TABSIZ;
00110 OUTSTR("TABTOT= "&CVS(TABTOT)&CRLF);
00120 FLAG←0; SIG(P); FLAG←-1; ⊂ To preset addrssses in SIG;
00130 CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00140 LOOKUP(CHAN1,"LRN.DAT",0);ARRYIN(CHAN1,LRN[0],TABTOT);CLOSE(CHAN1);
00150 RELEASE(CHAN1);
00160 FILEL←STRIN("Data file list (LIST28) = ");
00170 IF FILEL="" THEN FILEL←"LIST28";
00180 CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,3500,BRK,EOFA);
00190 LOOKUP(CHAN5,FILEL,ER);
00200 WHILE ER DO BEGIN OUTSTR(CRLF&"Can't find "&FILEL&" File = ");
00210 LOOKUP(CHAN5,FILEL←INCHWL,ER); END; EOFA←0;
00220 FILLST←INPUT(CHAN5,14); EOFA←0; RL←0;
00230
00240 WHILE EOFA=0 DO BEGIN "LISTREAD"
00250 HINDEX←21; HCOUNT←HINCNT←0;
00260 FILEI←SCAN(FILLST,1,J); IF FILEI="" THEN DONE;
00270 EOF←0;
00280 CLOSE(CHAN4); OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
00290 LOOKUP(CHAN4,FILEI,ER);
00300 ARRYIN(CHAN4,LFILE[0],'200);
00310 SEGTOT←(LFILE[0]*6)%256;
00320 OUTSTR(FILEI&" "&CVS(SEGTOT)&" seg. ");
00330 HINDEX←21; HCOUNT←HINCNT←0; SEGC←0;
00340
00350 WHILE TRUE DO BEGIN "ARRYIN"
00360 FOR I←0 STEP 1 UNTIL 255 DO INDATA[I]←0;
00370 IF EOF≠0 THEN DONE;
00380 ARRYIN(CHAN4,INDATA[0],256); ⊃ OUTSTR("256 words read in. "&CRLF);
00390 BPT←POINT(6,INDATA[0],-1);
00400
00410 FOR Q←0 STEP 1 UNTIL 63 DO BEGIN
00420 SEGC←SEGC+1; ⊃ OUTSTR(CVS(SEGC)&TB); IF SEGC>SEGTOT THEN DONE;
00430 FOR P←0 STEP 1 UNTIL 23 DO INDAT[P]←ILDB(BPT);
00440 J←HEADER;
00450 ⊃ OUTSTR(CVSTR(J)); ⊃ OUTSTR(CRLF);
00460 IF J≠NU THEN FOR I←0 STEP 1 UNTIL 63 DO BEGIN
00470 IF PHLIST[I]=J THEN BEGIN HINT←HLIST[I]; PHW←J; DONE ; END;
00480 IF PHLIST[I]=0 THEN BEGIN
00490 OUTSTR("Hint not identified "&CVSTR(J));
00500 OUTSTR(" at " &CVS(SEGC)&CRLF);DONE END;
00510 END;
00520
00530 IF J≠NU THEN SIG(P);
00540 END; END "ARRYIN";
00550
00560 OUTSTR(CVS(HINCNT)&" hints . ");
00570 IF RL=0 THEN RL←1 ELSE BEGIN RL←0; OUTSTR(CRLF); END;
00580 UPDATE;
00590 IF EOFA≠0 THEN DONE;
00600 END "LISTREAD";
00610 RELEASE(CHAN1); RELEASE(CHAN2); RELEASE(CHAN3); RELEASE(CHAN4);
00620
00630 OUTSTR("Tables saved"&CRLF);
00640 END "SAY";